COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	{$NOMAIN	Editor: Aux routines for parsing }
C00005 00003	(* aux function for motion clauses: thenCode *)
C00007 00004	(* waitParse *)
C00009 00005	(* armMagicParse *)
C00013 ENDMK
C⊗;
{$NOMAIN	Editor: Aux routines for parsing }

%include eparse.hdr;

{ Externally defined routines from elsewhere: }

	(* From ALLOC *)
function newNode: nodep;					external;
function newStatement: statementp;				external;

	(* From EROOT:  Inter-overlay calls *)
function e3gExprParse: nodep;					external;
procedure e3gGetArgs(opn: nodep);				external;

	(* From EAUX1A *)
function makeNVar(vartype: datatypes; vid: identp): varidefp;	external;

	(* From EAUX1B *)
function checkArg(n: nodep; d: datatypes): nodep;		external;
procedure appendEnd(s,so: statementp);				external;

	(* From EAUX1C *)
procedure errprnt;						external;
function evalOrder(what,last: nodep; pcons: boolean): nodep;	external;
procedure relExpr(n: nodep);					external;

	(* From EAUX2A *)
procedure makeNewVar(newvar: varidefp);				external;

	(* From ETOKEN *)
procedure getToken;						external;
procedure getDelim(char: ascii);				external;

	(* From PP *)
procedure ppLine; 						external;
procedure ppOutNow; 						external;
procedure ppChar(ch: ascii); 					external;
procedure pp5(ch: c5str; length: integer); 			external;
procedure pp10(ch: cstring; length: integer); 			external;
procedure pp10L(ch: cstring; length: integer);			external;
procedure pp20(ch: c20str; length: integer); 			external;
procedure pp20L(ch: c20str; length: integer); 			external;
procedure ppInt(i: integer); 					external;
procedure ppReal(r: real); 					external;
procedure ppStrng(length: integer; s: strngp); 			external;
procedure ppDtype(d: datatypes);				external;
procedure ppDelChar; 						external;


procedure ePar3gGet; external;
procedure ePar3gGet;  begin end;

(* aux function for motion clauses: thenCode *)

function thenCode(evp: boolean; s: statementp): statementp; external;
function thenCode;
 var st: statementp; n: nodep; v: varidefp;
 begin
 if s↑.stype = signaltype then st := s		(* treat signal specially *)
  else
   begin
   st := newStatement;
   with st↑ do			(* make a cmon to execute the code *)
    begin
    stype := cmtype;
    deferCm := false;
    exprCm := false;
    conclusion := s;
    appendEnd(st,s);
    n := newNode;
    oncond := n;
    end;
   v := makeNVar(cmontype,nil);	(* make a variable for the cmon *)
   v↑.s := st;
   st↑.cdef := v;
   if evp then		(* do we need to make an event variable? *)
     begin
     with n↑ do
      begin
      ntype := leafnode;
      ltype := varitype;
      vari := makeNVar(eventtype,nil);
      makeNewVar(vari);	(* if active block deal with environment entry *)
      vid := nil;
      end;
     end;
   makeNewVar(v);	(* if active block deal with environment entry *)
   end;
 thenCode := st;
 end;

(* waitParse *)

procedure waitParse(sp: statementp); external;
procedure waitParse;
 begin
 with sp↑ do
  begin
  event := checkArg(e3gExprParse,eventtype);
  exprs := nil;
  with event↑ do			(* make sure it's a variable *)
   if not (((ntype = leafnode) and (ltype = varitype)) or
	   ((ntype = exprnode) and (op = arefop))) then
     begin		(* no good *)
     pp20L(' Need an event varia',20); pp10('ble here  ',8); errprnt;
     relExpr(event);
     event := nil;
     end
    else
     if ntype <> leafnode then exprs := evalOrder(arg2,nil,true);
  end;
 end;

(* armMagicParse *)

procedure armMagicParse(sp: statementp); external;
procedure armMagicParse;
 var n,lexpr: nodep; b: boolean;
 begin
 with sp↑ do
  begin
  cmdnum := checkArg(e3gExprParse,svaltype);
  getDelim(',');
  dev := e3gExprParse;
  if dev = nil then b := true
   else
    with dev↑ do			(* make sure it's a variable *)
     begin
     b := (ntype <> leafnode) or (ltype <> varitype);
     if b then b := (ntype <> exprnode) or (op <> arefop);
     end;
  if b then
    begin
    pp20L(' Need a device varia',20); pp10('ble here  ',8); errprnt;
    bad := true;			(* mark statement as bad *)
    end
   else
    bad := false;			(* statement is ok *)
  getToken;
  backup := true;
  if (not endOfLine) or
     (curToken.ttype <> delimtype) or (curToken.ch <> ';') then getDelim(',');
  pnode↑.arg2 := nil;
  e3gGetArgs(pnode);			(* pretend we just saw a queryop *)
  iargs := pnode↑.arg2;			(* store away pointer to argument list *)
  getToken;
  backup := true;
  if (not endOfLine) or
     (curToken.ttype <> delimtype) or (curToken.ch <> ';') then getDelim(',');
  pnode↑.arg2 := nil;
  e3gGetArgs(pnode);			(* do it all again for results list *)
  oargs := pnode↑.arg2;
  n := oargs;
  b := false;
  while (n <> nil) and not b do
   begin		(* make sure each entry in result list is a variable *)
   with n↑.lval↑ do
    begin
    b := (ntype <> leafnode) or (ltype <> varitype);
    if b then b := (ntype <> exprnode) or (op <> arefop);
    end;
   n := n↑.next;
   end;
  if b then
    begin
    pp20L(' Can only have varia',20); pp10('bles here ',9); errprnt;
    bad := true;				(* mark statement as bad *)
    end;
  if not bad then
    begin					(* set up exprs field *)
    lexpr := evalOrder(cmdnum,nil,true);
    if dev <> nil then				(* evaluate device *)
     if dev↑.ntype <> leafnode then
       lexpr := evalOrder(dev↑.arg2,nil,true);	(* push array subscripts *)
    lexpr := evalOrder(iargs,lexpr,true);	(* push input arguments *)
    n := oargs;
    while n <> nil do
     with n↑ do
      begin				(* push any subscripts in result list *)
      if lval↑.ntype = exprnode then lexpr := evalOrder(n↑.lval,lexpr,true);
      n := next;
      end;
    exprs := lexpr;
    end;

  end;
 end;